Software Vault: The Gold Collection/Software Vault - The Gold Collection (American Databankers) (1993).ISO/cdr48/pas_0593.zip/STARWARP.PAS

Pascal/Delphi Source File | 1993-05-30 | 4KB | 124 lines

{─ Fido Pascal Conference ────────────────────────────────────────────── PASCAL ─
Msg  : 641 of 728
From : Sean Palmer                         1:104/123.0          07 May 93  15:10
To   : Micah Lindsey
Subj : StarWarp
────────────────────────────────────────────────────────────────────────────────
ML> SP> Trick is to start them in the center, with a (slow) random speed for X
ML> SP> and Y, and while they are still on the screen, multiply the speed by a
ML> SP> fraction like 1.02 or something small like that so they speed up as
ML> SP> they come "toward" you... (inc(speedX,speedX div 64) or something would
ML> SP> work too, for fixed-point numbers.) If they go off the edge of the
ML> SP> screen, put them back in the middle with a new  random speed.
ML> SP> Also making them get bigger as they come would be nice.
ML> SP> If you can't figure it out yourself I could whip something up for
ML> SP> ya... _

ML>        I've just recently started working with graphics, and I'd like to
ML>        take a look at that.  I'd particularly like to know how to animate
ML>        something.

Ok, here's some source I just whipped up.}

{$A-,B-,D+,E-,F-,G+,I-,L+,N-,O-,R-,S-,V-,X+}
{$M $2000,0,0}
program starwarp;
uses crt;
const
 xRes=320;
 yRes=200;
var color:byte;
type
 fixed=record case boolean of false:(l:longint);true:(f:word;i:integer);end;
 star=record x,y:fixed;xs,ys:longint; timer:word; end;
const numStars=128;
var
 a:array[0..numStars-1]of star;
 curStar:^Star;
 i:integer;

var inPort1:word;
procedure waitRetrace;assembler;asm
 mov dx,inPort1; {find crt status reg (input port #1)}
@L1: in al,dx; test al,8; jnz @L1;  {wait for no v retrace}
@L2: in al,dx; test al,8; jz @L2; {wait for v retrace}
 end;

const
 tableWriteIndex=$3C8;
 tableDataRegister=$3C9;

procedure setColor(color,r,g,b:byte);assembler;asm {set DAC color}
 mov dx,tableWriteIndex; mov al,color; out dx,al; inc dx;
 mov al,r; out dx,al; mov al,g; out dx,al; mov al,b;out dx,al;
 end; {write index now points to next color}

{plot a pixel in mode $13}
procedure plot(x,y:word);Inline(
  $5E/                   { pop si  ;y}
  $5F/                   { pop di  ;x}
  $B8/$00/$A0/           { mov ax,$A000}
  $8E/$C0/               { mov es,ax}
  $B8/$40/$01/           { mov ax,320}
  $F7/$E6/               { mul si}
  $01/$C7/               { add di,ax}
  $8B/$06/>color/        { mov ax,[color]}
  $AA);                  { stosb}


procedure recenterStar;begin
 with curStar^ do begin
  timer:=0;
  x.f:=0;x.i:=xRes div 2;
  y.f:=0;y.i:=yRes div 2;
  xs:=integer(random(65535)); if xs<0 then inc(xs);
  ys:=integer(random(65535)); if ys<0 then inc(ys);
  end;
 end;

procedure eraseStar;begin
 with curStar^ do begin
  color:=0;
  plot(x.i,y.i);
  end;
 end;

procedure moveStar;begin
 with curStar^ do begin
  inc(x.l,xs);
  inc(y.l,ys);
  inc(xs,xs div 8);
  inc(ys,ys div 8);
  if (timer>=64) or (word(x.i)>=xRes) or (word(y.i)>=yRes) then
    recenterStar;
  inc(timer)
  end;
 end;

procedure drawStar;begin
 with curStar^ do begin
  color:=succ(timer shr 3);
  plot(x.i,y.i);
  end;
 end;

begin
 inPort1:=memw[$40:$63]+6;
 asm mov ax,$13; int $10; end;
 for i:=0 to 8 do setcolor(i,i*6,i*5,i*7);
 for i:=0 to numStars-1 do begin
  curStar:=@a[i];
  recenterStar;
  end;
 repeat
  for i:=0 to numStars-1 do begin
   curStar:=@a[i];
   eraseStar;
   moveStar;
   drawStar;
   end;
  waitRetrace;
  until keypressed;
 readkey;
 textmode(c80);
 end.